<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>util.c</title>
<style type="text/css">
<!--
body.hl	{ background-color:#ffffff; }
pre.hl	{ color:#000000; background-color:#ffffff; font-size:10pt; font-family:'Courier New';}
.hl.num { color:#ff0000; }
.hl.esc { color:#ff22ff; }
.hl.str { color:#ff0000; }
.hl.dstr { color:#ff0000; }
.hl.slc { color:#0000ff; }
.hl.com { color:#0000ff; }
.hl.dir { color:#ff22ff; }
.hl.sym { color:#000000; }
.hl.line { color:#0000ff; }
.hl.mark	{ background-color:#ffffbb;}
.hl.kwa { color:#b26818; }
.hl.kwb { color:#00ff00; }
.hl.kwc { color:#b26818; }
.hl.kwd { color:#000000; }
//-->
</style>
</head>
<body class="hl">
<pre class="hl"><span class="hl com">/*</span>
<span class="hl com"> *  util.c</span>
<span class="hl com"> *  scheme2</span>
<span class="hl com"> *</span>
<span class="hl com"> *  Created by Leo Katzenstein on 5/26/07.</span>
<span class="hl com"> *  Copyright 2007 __MyCompanyName__. All rights reserved.</span>
<span class="hl com"> *</span>
<span class="hl com"> */</span>

<span class="hl dir">#include</span> <span class="hl dstr">&quot;scheme.h&quot;</span><span class="hl dir"></span>

Pair <span class="hl sym">*</span><span class="hl kwd">cons</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>car<span class="hl sym">,</span> Pair <span class="hl sym">*</span>cdr<span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">;</span>
    p <span class="hl sym">=</span> <span class="hl kwa">new</span><span class="hl sym">(</span>Pair<span class="hl sym">);</span>
    p<span class="hl sym">-&gt;</span>car <span class="hl sym">=</span> car<span class="hl sym">;</span>
    p<span class="hl sym">-&gt;</span>cdr <span class="hl sym">=</span> cdr<span class="hl sym">;</span>
    <span class="hl kwa">return</span> p<span class="hl sym">;</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">make_num</span><span class="hl sym">(</span><span class="hl kwb">long</span> n<span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">;</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span>FIXNUM<span class="hl sym">, (</span>Pair <span class="hl sym">*)</span> n<span class="hl sym">);</span>
    <span class="hl kwa">return</span> p<span class="hl sym">;</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">make_double</span><span class="hl sym">(</span><span class="hl kwb">double</span> d<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwb">double</span> <span class="hl sym">*</span>q<span class="hl sym">;</span>
    q <span class="hl sym">=</span> <span class="hl kwa">new</span><span class="hl sym">(</span><span class="hl kwb">double</span><span class="hl sym">);</span>
    <span class="hl sym">*</span>q <span class="hl sym">=</span> d<span class="hl sym">;</span>
    <span class="hl kwa">return</span> <span class="hl kwd">cons</span><span class="hl sym">(</span>DOUBLE<span class="hl sym">, (</span>Pair <span class="hl sym">*)</span> q<span class="hl sym">);</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">make_func</span><span class="hl sym">(</span>PF f<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwa">return</span> <span class="hl kwd">cons</span><span class="hl sym">(</span>FUNC<span class="hl sym">, (</span>Pair <span class="hl sym">*)</span> f<span class="hl sym">);</span>
<span class="hl sym">}</span>

<span class="hl kwb">char</span> <span class="hl sym">*</span><span class="hl kwd">pname</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>sym<span class="hl sym">)</span>
<span class="hl sym">{</span>
    <span class="hl kwa">if</span> <span class="hl sym">(!</span><span class="hl kwd">is_symbol</span><span class="hl sym">(</span>sym<span class="hl sym">))</span>
        <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;attempt to find the pname of a non symbol&quot;</span><span class="hl sym">);</span>
    <span class="hl kwa">for</span> <span class="hl sym">(</span>sym <span class="hl sym">=</span> sym<span class="hl sym">-&gt;</span>cdr<span class="hl sym">;</span> sym<span class="hl sym">;</span> sym <span class="hl sym">=</span> sym<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">if</span> <span class="hl sym">(</span>sym<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> PNAME<span class="hl sym">)</span>
            <span class="hl kwa">return</span> <span class="hl sym">(</span><span class="hl kwb">char</span> <span class="hl sym">*)</span> sym<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>cdr<span class="hl sym">;</span>
    <span class="hl sym">}</span>
    <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;pname: PNAME not defined&quot;</span><span class="hl sym">);</span>
    <span class="hl kwa">return</span> NULL<span class="hl sym">;</span> <span class="hl com">/* quiet the warning */</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">make_sym</span><span class="hl sym">(</span><span class="hl kwb">char</span> <span class="hl sym">*</span>pn<span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">, *</span>q<span class="hl sym">;</span>

    <span class="hl com">/* return it if it already exists */</span>
    <span class="hl kwa">for</span> <span class="hl sym">(</span>p <span class="hl sym">=</span> sym_list<span class="hl sym">;</span> p<span class="hl sym">;</span> p <span class="hl sym">=</span> p<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">if</span> <span class="hl sym">(!</span><span class="hl kwd">strcmp</span><span class="hl sym">(</span><span class="hl kwd">pname</span><span class="hl sym">(</span>p<span class="hl sym">-&gt;</span>car<span class="hl sym">),</span> pn<span class="hl sym">))</span>
            <span class="hl kwa">return</span> p<span class="hl sym">-&gt;</span>car<span class="hl sym">;</span>
    <span class="hl sym">}</span>

    <span class="hl com">/* ain't there, make it */</span>
    <span class="hl com">/* create the pname property */</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> PNAME<span class="hl sym">, (</span>Pair <span class="hl sym">*)</span> <span class="hl kwd">strdup</span><span class="hl sym">(</span>pn<span class="hl sym">) );</span>

    <span class="hl com">/* create the single p-list entry */</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> p<span class="hl sym">,</span> NULL <span class="hl sym">);</span>

    <span class="hl com">/* create the symbol */</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> SYMBOL<span class="hl sym">,</span> p <span class="hl sym">);</span>

    <span class="hl com">/* push it onto the symbol list */</span>
    q <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> p<span class="hl sym">,</span> sym_list <span class="hl sym">);</span>
    sym_list <span class="hl sym">=</span> q<span class="hl sym">;</span>
    <span class="hl kwa">return</span> p<span class="hl sym">;</span>
<span class="hl sym">}</span>

<span class="hl com">/*</span>
<span class="hl com"> * Make a lambda binding</span>
<span class="hl com"> * parameters are the lambda expression cdr and the env</span>
<span class="hl com"> * ('lambda env args body)</span>
<span class="hl com"> */</span>
Pair <span class="hl sym">*</span><span class="hl kwd">make_lambda</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>l<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env<span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">;</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> env<span class="hl sym">,</span> l <span class="hl sym">);</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> LAMBDA<span class="hl sym">,</span> p <span class="hl sym">);</span>
    <span class="hl kwa">return</span> p<span class="hl sym">;</span>
<span class="hl sym">}</span>

<span class="hl com">/* sets the value in an environment */</span>
Pair <span class="hl sym">*</span><span class="hl kwd">setf</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>sym<span class="hl sym">,</span> Pair <span class="hl sym">*</span>val<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env<span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">, *</span>e<span class="hl sym">;</span>

    <span class="hl kwa">for</span> <span class="hl sym">(</span>e <span class="hl sym">=</span> env<span class="hl sym">;</span> e<span class="hl sym">;</span> e <span class="hl sym">=</span> e<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">for</span> <span class="hl sym">(</span>p <span class="hl sym">=</span> e<span class="hl sym">-&gt;</span>car<span class="hl sym">;</span> p<span class="hl sym">;</span> p <span class="hl sym">=</span> p<span class="hl sym">-&gt;</span>cdr<span class="hl sym">)</span>
        <span class="hl sym">{</span>
            <span class="hl kwa">if</span> <span class="hl sym">(</span>p<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> sym<span class="hl sym">)</span>
            <span class="hl sym">{</span>
                p<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>cdr <span class="hl sym">=</span> val<span class="hl sym">;</span>
                <span class="hl kwa">return</span> val<span class="hl sym">;</span>
            <span class="hl sym">}</span>
        <span class="hl sym">}</span>
    <span class="hl sym">}</span>

    <span class="hl com">/* This may not be the right thing for free symbols */</span>
    p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span><span class="hl kwd">cons</span><span class="hl sym">(</span>sym<span class="hl sym">,</span> val<span class="hl sym">),</span> env<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>
    env<span class="hl sym">-&gt;</span>car <span class="hl sym">=</span> p<span class="hl sym">;</span>
    <span class="hl kwa">return</span> val<span class="hl sym">;</span>
<span class="hl sym">}</span>

<span class="hl com">/*</span>
<span class="hl com"> * Create a list of pairs from the lists a and b,</span>
<span class="hl com"> * the lists a and b must be the same length.</span>
<span class="hl com"> */</span>

Pair <span class="hl sym">*</span><span class="hl kwd">pairlis</span><span class="hl sym">(</span>Pair <span class="hl sym">*</span>a<span class="hl sym">,</span> Pair <span class="hl sym">*</span>b<span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair head<span class="hl sym">;</span>
    Pair <span class="hl sym">*</span>tl<span class="hl sym">;</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">, *</span>q<span class="hl sym">;</span>

    head<span class="hl sym">.</span>cdr <span class="hl sym">=</span> NULL<span class="hl sym">;</span>
    tl <span class="hl sym">= &amp;</span>head<span class="hl sym">;</span>

    <span class="hl kwa">while</span> <span class="hl sym">(</span>a <span class="hl sym">&amp;&amp;</span> b<span class="hl sym">)</span>
    <span class="hl sym">{</span>
        p <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span>a<span class="hl sym">-&gt;</span>car<span class="hl sym">,</span> b<span class="hl sym">-&gt;</span>car<span class="hl sym">);</span>  <span class="hl com">/* make the pair */</span>
        q <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span>p<span class="hl sym">,</span> NULL<span class="hl sym">);</span>         <span class="hl com">/* append it */</span>
        tl<span class="hl sym">-&gt;</span>cdr <span class="hl sym">=</span> q<span class="hl sym">;</span>
        tl <span class="hl sym">=</span> q<span class="hl sym">;</span>
        a <span class="hl sym">=</span> a<span class="hl sym">-&gt;</span>cdr<span class="hl sym">;</span>                      <span class="hl com">/* next */</span>
        b <span class="hl sym">=</span> b<span class="hl sym">-&gt;</span>cdr<span class="hl sym">;</span>
    <span class="hl sym">}</span>
    <span class="hl kwa">if</span> <span class="hl sym">(</span>a <span class="hl sym">||</span> b<span class="hl sym">)</span>
        <span class="hl kwd">error</span><span class="hl sym">(</span><span class="hl str">&quot;pairlis: unequal list lengths&quot;</span><span class="hl sym">);</span>

    <span class="hl kwa">return</span> head<span class="hl sym">.</span>cdr<span class="hl sym">;</span>
<span class="hl sym">}</span>
</pre>
</body>
</html>
<!--HTML generated by highlight 2.6.14, http://www.andre-simon.de/-->
